home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0391B.ZIP / JWINDOW.ARC / DIR.INC next >
Text File  |  1985-09-15  |  2KB  |  73 lines
  1. { Procedure dir.inc}
  2.  
  3.   Procedure Dir;
  4.    Type
  5.        RegPack = record
  6.                  AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : Integer
  7.                  end;
  8.  
  9.   Var  Path : string[60];
  10.        Fcb, Dta :String[44];    {length for extended handle calls}
  11.        Regs : Regpack;
  12.        Filename  : string[12];
  13.        I         : byte;
  14. Begin
  15.   clrscr;
  16.   Getdir (0,Path);
  17.   Writeln ('     Current directory is ',path,#10#13);
  18.   Fcb := #255#0#0#0#0#0#0#0'????????????'    ; {our command for the search }
  19.  
  20.    { put a bunch of nothing in the data transfer area }
  21.   Dta := '                                                ';
  22.   { must let dos know where to put the information }
  23.    With Regs do
  24.    begin
  25.   DS := seg(Dta);     {point to the segment}
  26.   DX := ofs(Dta)+1;   { get the offset plus one, since first byte
  27.                              contains length of string                }
  28.     end;
  29.   {let dos set the transfer address }
  30.     With Regs do
  31.     begin
  32.    AX  := $1A shl 8;    { dos function to perform }
  33.    Msdos(Regs);
  34.      end;
  35.  
  36.    { now have to set the registers to the search fcb }
  37.      With Regs do
  38.      begin
  39.    DS := Seg(Fcb);      {load the segment value}
  40.    DX := Ofs(Fcb)+1;    { now the offset plus 1}
  41.      end;
  42.  
  43.    { to start the search must set msdos func. 11 }
  44.     With Regs do
  45.     begin
  46.    AX := $11 shl 8;     { set dos function 11H}
  47.     end;
  48.    Msdos(Regs);
  49.    Write( '     ',copy (Dta,9,8),'.',copy (dta,17,3));
  50.    I := 2;
  51.    {   ----------- now set function in ah to 12h to continue ------ }
  52.     With Regs do
  53.     begin
  54.    AX := 4608;    {you can use decimal set dos function 12H }
  55.      end;
  56.    While regs.AX = 4608  do     {repeat till done }
  57.      begin
  58.    Msdos(regs);
  59.      filename := copy(Dta,9,8) + '.' + copy(Dta,17,3);
  60.  
  61.    If I > 3 then
  62.      begin
  63.      write(#10,#13);
  64.      I := 1;
  65.      end;
  66.    Write ('     ',filename);
  67.      I := I + 1;
  68.     end;
  69.   end;
  70.  
  71.     { end of small dir routine }
  72.  
  73.